CLEAR ,20000
CLEAR ,55000
WINDOW CLOSE 1
SCREEN 2,320,200,5,1
WINDOW 2,"Puzzle Pro v1.02 by Syd L. Bolton",,16,2
RANDOMIZE TIMER
PALETTE 0,0,0,0
DEFINT a-z
DIM a(203,49),s(49),x(49),y(49),state(49),s$(49),scolor!(31,3),ocolor!(31,3)
s1$=STRING$(26,0)
POKE SADD(s1$)+11,5
POKE SADD(s1$)+15,20
POKE SADD(s1$)+19,20
POKE SADD(s1$)+21,24
POKE SADD(s1$)+23,31
CLS
LINE (57,38)-(263,142),3,b
LINE (56,37)-(264,143),3,b
f$="Puzzle Pro.pzl"
GOSUB GetPuzzle
FOR i=0 TO 31
FOR j=1 TO 3
ocolor!(i,j)=scolor!(i,j)
NEXT
NEXT
FOR c=0 TO 4
FOR r=0 TO 9
PUT (60+r*20,40+c*20),a(0,c*10+r)
NEXT:NEXT
MENU 1,0,1,"Puzzle"
MENU 1,1,1,"Start   "
MENU 1,2,1,"Open    "
MENU 1,3,1,"Cmd File"
MENU 1,4,1,"Create  "
MENU 1,5,1,"Quit    "
MENU 2,0,1,"Options"
MENU 2,1,1,"  Lines  "
MENU 2,2,1,"  Dots   "
MENU 2,3,1,"  Boxes  "
MENU 2,4,1,"  F.Boxes"
MENU 2,5,1,"  Ovals  "
MENU 2,6,1,"  F.Ovals"
MENU 3,0,1,"About..."
MENU 3,1,1,"Author "
MENU 3,2,1,"Game   "
MENU 3,3,1,"Playing"
MENU 3,4,1,"Updates"
MENU 4,0,1,""
ON ERROR GOTO 0
ON MENU GOSUB menuhandler
MENU ON
Forever: GOTO Forever
menuhandler:            
a=MENU(0):b=MENU(1)  
IF a=1 THEN MENU OFF:ON b GOSUB Main,OpenPuzzle,CmdFile,create,quit:MENU ON:RETURN
IF a=2 THEN
c(b)=1-c(b)
MENU 2,b,c(b)+1  
END IF
IF a=3 THEN MENU OFF:GOSUB About:MENU ON:RETURN
RETURN
Main:
IF getpuz THEN CmdGet
CLS
LOCATE 1,1:COLOR 1:INPUT "Difficulty Level (1-5)";diff
IF diff<1 OR diff>5 THEN Main
DiffLevel:
diff=(6-diff)*500
LINE (57,38)-(263,142),3,b
LINE (56,37)-(264,143),3,b
LINE (60,40)-(260,140),0,bf
FOR i=0 TO 49
s(i)=i:state(i)=1
NEXT
FOR i=0 TO 49
SWAP s(i),s(INT(RND*50))
NEXT
LOCATE 1,1:PRINT STRING$(38,32)
FOR i=0 TO 11
PUT (24.5*i,14),a(0,s(i)):x(s(i))=24.5*i:y(s(i))=14
PUT (24.5*i,146),a(0,s(i+13)):x(s(i+13))=24.5*i:y(s(i+13))=146
NEXT
PUT (292,14),a(0,s(12)):x(s(12))=292:y(s(12))=14
PUT (292,146),a(0,s(25)):x(s(25))=292:y(s(25))=146
FOR i=26 TO 30
PUT (0,36+22*(i-26)),a(0,s(i)):x(s(i))=0:y(s(i))=36+22*(i-26)
PUT (24,36+22*(i-26)),a(0,s(i+5)):x(s(i+5))=24:y(s(i+5))=36+22*(i-26)
PUT (270,36+22*(i-26)),a(0,s(i+10)):x(s(i+10))=270:y(s(i+10))=36+22*(i-26)
PUT (292,36+22*(i-26)),a(0,s(i+15)):x(s(i+15))=292:y(s(i+15))=36+22*(i-26)
NEXT
FOR i=46 TO 48
PUT (122+25*(i-46),168),a(0,s(i)):x(s(i))=122+25*(i-46):y(s(i))=168
NEXT
LOCATE 23,7:PRINT "PAUSE";:LOCATE 23,31:PRINT "CHEAT";
LINE (45,174)-(89,184),3,b
LINE (237,174)-(281,184),3,b
p=s(49)
c=INT(p/10):r=p-c*10
PUT (60+r*20,40+c*20),a(0,s(49)):state(s(49))=0
np=49
t!=TIMER
done=0:ms=0    
loop:
WHILE ms=0
ms=MOUSE(0)
LOCATE 1,17:PRINT "Timer:";INT(TIMER-t!)
IF INT(TIMER-t!)=>diff THEN done=1:LOCATE 1,1:PRINT STRING$(38,32):LOCATE 1,17:COLOR 1:PRINT"TIME UP!":ms=1
IF INKEY$="q" OR INKEY$="Q" THEN LOCATE 1,1:PRINT STRING$(38,32):LOCATE 1,16:COLOR 1:PRINT"GAME OVER":done=1:ms=1
WEND
IF done THEN lastpuz=0:getpuz=0:RETURN
ms=0
x=MOUSE(1):y=MOUSE(2)
piece=-1
FOR i=0 TO 49
IF (x>=x(i) AND x<=x(i)+20) AND (y>=y(i) AND y<=y(i)+20) THEN IF state(i)=1 THEN piece=i:i=49
NEXT
IF piece>-1 THEN There
IF x>45 THEN IF x<89 THEN IF y>174 THEN IF y<184 THEN pause
IF x>237 THEN IF x<281 THEN IF y>174 THEN IF y<184 THEN cheat
IF piece=-1 THEN PRINT CHR$(7);:zz=MOUSE(0):GOTO loop
There:
PUT (x(piece),y(piece)),a(0,piece)
OBJECT.SHAPE 1,s1$+s$(piece)
OBJECT.X 1,x(piece):OBJECT.Y 1,y(piece)
x=x(piece):y=y(piece)
OBJECT.ON 1
yep:
WHILE MOUSE(0)<0
x=MOUSE(5):y=MOUSE(6)
IF x<295 THEN OBJECT.X 1,x:OBJECT.Y 1,y  
WEND
x=x+3:y=y+3
x=x-60:y=y-40
IF x<0 OR y<0 OR x>260 OR y>140 THEN OBJECT.OFF 1:PUT (x(piece),y(piece)),a(0,piece):GOTO loop
place=INT(x/20)+10*INT(y/20)
IF place<>piece THEN OBJECT.OFF 1:PUT (x(piece),y(piece)),a(0,piece):GOTO loop
OBJECT.OFF 1
y=INT(place/10):x=place-y*10
PUT (60+x*20,40+y*20),a(0,piece):state(piece)=0:np=np-1:IF np=0 THEN EndPuzzle
GOTO loop
pause:
t2!=TIMER
WINDOW 3,"<- Click here to resume",(63,51)-(257,138),8,2
COLOR 1
PRINT:PRINT:PRINT 
PRINT " ***  *  * * *** *** **"
PRINT " * * * * * * *   *   * *"
PRINT " *** *** * * *** **  * *"
PRINT " *   * * * *   * *   * *"
PRINT " *   * * *** *** *** **"
r!=1:g!=1:b!=1:in!=-0.03
WHILE (WINDOW(7)<>0 AND WINDOW(1)=3)
PALETTE 1,r!,g!,b!
r!=r!+in!:IF r!>=1 THEN in!=-in! :ELSE IF r!<=0 THEN in!=-in!
g!=r!:b!=r!  
WEND
WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
PALETTE 1,scolor!(1,1),scolor!(1,2),scolor!(1,3)
zz=MOUSE(0)
t!=t!+(TIMER-t2!)
GOTO loop
cheat:
WINDOW 3,"Cheat!",(57,39)-(263,142),0,2
x=MOUSE(0)
COLOR 2,0
PRINT:PRINT" Remember, cheaters":PRINT:PRINT" pay for it." 
COLOR 1,0
LOCATE 9,2:PRINT"GIVE PIECE":LOCATE 9,15:PRINT"SHOW PUZZLE"
LOCATE 11,11:PRINT"CANCEL"
LINE (6,62)-(88,72),2,b
LINE (111,62)-(200,72),2,b
LINE (78,78)-(128,88),2,b
cheatit:
WHILE MOUSE(0)=0:WEND
x=MOUSE(1):y=MOUSE(2)
IF x>6 THEN IF x<88 THEN IF y>62 THEN IF y<72 THEN GivePiece
IF x>111 THEN IF x<200 THEN IF y>62 THEN IF y<72 THEN ShowPuzzle
IF x>78 THEN IF x<128 THEN IF y>78 THEN IF y<88 THEN WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2:WHILE MOUSE(0)<>0:WEND:GOTO loop
GOTO cheatit
GivePiece:
WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
FOR i=0 TO 49
IF state(s(i))=1 THEN piece=s(i):i=49
NEXT
PUT (x(piece),y(piece)),a(0,piece)
state(piece)=0
y=INT(piece/10):x=piece-y*10
PUT (60+x*20,40+y*20),a(0,piece):np=np-1:IF np=0 THEN EndPuzzle
t!=t!-90
WHILE MOUSE(0)<>0:WEND
GOTO loop
ShowPuzzle:
WINDOW 3,"<- Click here to resume",,8
CLS
FOR c=0 TO 4
FOR r=0 TO 9
PUT (3+r*20,2+c*20),a(0,c*10+r)
NEXT:NEXT
ct!=TIMER
WHILE (WINDOW(7)<>0 AND WINDOW(1)=3):WEND
WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
t!=t!-((TIMER-ct!)*5)
WHILE MOUSE(0)<>0:WEND
GOTO loop
EndPuzzle:
LOCATE 1,8:PRINT"Finished in";INT(TIMER-t!);"seconds."
IF lastpuz THEN lastpuz=0:getpuz=0:RETURN
IF getpuz THEN CmdGet
RETURN
GetPuzzle:
ON ERROR GOTO DiskError
OPEN f$ FOR INPUT AS #1
INPUT#1,a$:IF a$<>"BPFF" THEN ERROR 53
LOCATE 1,1:PRINT STRING$(38,32)
LOCATE 1,15:PRINT "LOADING..."
FOR i=0 TO 31
INPUT#1,scolor!(i,1),scolor!(i,2),scolor!(i,3)
NEXT
FOR i=0 TO 49
s$(i)=INPUT$(400,1)
NEXT
FOR i=0 TO 49
FOR j=0 TO 203
a(j,i)=CVI(INPUT$(2,1))
NEXT j 
NEXT i
INPUT#1,Cycle
CLOSE#1
CLS
LINE (57,38)-(263,142),3,b
LINE (56,37)-(264,143),3,b
FOR i=0 TO 31
PALETTE i,scolor!(i,1),scolor!(i,2),scolor!(i,3)
NEXT
RETURN
nothing:
RETURN
OpenPuzzle:
WINDOW 3,"Open Puzzle",(63,51)-(257,138),0,2
WINDOW OUTPUT 3
COLOR 1:PRINT:PRINT "Enter Puzzle Filename:"
LOCATE 9,4:PRINT "LOAD":LOCATE 9,16:PRINT "CANCEL"
LINE (22,62)-(56,72),2,b
LINE (118,62)-(168,72),2,b
cancel=0:GOSUB GetString
WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
IF cancel THEN RETURN
f$=in$+".pzl"
GOSUB GetPuzzle
LINE (60,40)-(260,140),0,bf
RETURN
GetString:
in$=""
LOCATE 5,2:COLOR 0,1:PRINT STRING$(23,32)
Cursor:
LOCATE 5,LEN(in$)+1:COLOR 0,2:PRINT " ":a$=""
Waititout:
a$=INKEY$:b=MOUSE(0):IF b=0 THEN IF a$="" THEN Waititout
IF b THEN CheckM
a=ASC(a$):IF a=8 THEN IF LEN(in$)>0 THEN in$=LEFT$(in$,LEN(in$)-1):LOCATE 5,LEN(in$)+2:COLOR 0,1:PRINT " ":GOTO Cursor
IF a=13 THEN IF LEN(in$)>0 THEN RETURN
IF (a>31 AND a<91 OR a>75 AND a<124) THEN IF LEN(in$)<23 THEN okkey
GOTO Waititout
CheckM:
x=MOUSE(1):y=MOUSE(2)
IF x>22 THEN IF x<56 THEN IF y>62 THEN IF y<72 THEN IF LEN(in$)>0 THEN RETURN
IF x>118 THEN IF x<168 THEN IF y>62 THEN IF y<72 THEN cancel=1:RETURN
GOTO Waititout
okkey:
in$=in$+a$:LOCATE 5,LEN(in$):COLOR 0,1:PRINT a$
GOTO Cursor
DiskError:
CLOSE#1
WINDOW 3,"Alert",(63,51)-(257,138),0,2
COLOR 2,0
IF ERR<50 THEN PRINT "Program Malfunction" :ELSE PRINT "Disk Error"
PRINT:PRINT:COLOR 1,0:IF ERR=53 THEN PRINT"File Not Found!":GOTO Choice
PRINT"Error:";ERR
Choice:
LOCATE 9,4:PRINT"RETRY":LOCATE 9,16:PRINT"CANCEL"
LINE (22,62)-(65,72),2,b
LINE (118,62)-(168,72),2,b
MakeIt:
WHILE MOUSE(0)=0:WEND
x=MOUSE(5):y=MOUSE(6)
IF x>22 THEN IF x<65 THEN IF y>62 THEN IF y<72 THEN WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2:MENU ON:RESUME NEXT
IF x>118 THEN IF x<168 THEN IF y>62 THEN IF y<72 THEN WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2:MENU ON:RESUME WaitMenu
GOTO MakeIt  
create:
nt=0
FOR i=1 TO 6
IF c(i)=1 THEN nt=nt+1
NEXT
IF nt=0 THEN PRINT CHR$(7);:RETURN
CLS
LINE (60,40)-(260,140),INT(RND*31)+1,bf
et=120/nt
WINDOW 3,"Create Puzzle",(57,39)-(263,142),0,2
COLOR 1,0
PRINT:PRINT:PRINT"Please wait while I make"
PRINT:PRINT"your puzzle..."
WINDOW OUTPUT 2
IF c(4)=1 THEN
FOR i=1 TO et
GOSUB pickrnd
LINE (x1+60,y1+40)-(x2+60,y2+40),INT(RND*32),bf
NEXT
END IF                 
IF c(6)=1 THEN
FOR i=1 TO et
GOSUB pickrnd
x1=x1+60
y1=y1+40
r=x1-60
IF r>160 THEN r=260-x1
IF y1-r<40 THEN r=y1-39
IF y1+r>140 THEN r=139-y1
c=INT(RND*32)
CIRCLE (x1,y1),INT(RND*r)/2+1,c
PAINT (x1,y1),c,c  
NEXT
END IF
IF c(3)=1 THEN
FOR i=1 TO et
GOSUB pickrnd
LINE (x1+60,y1+40)-(x2+60,y2+40),INT(RND*32),b
NEXT
END IF
IF c(5)=1 THEN
FOR i=1 TO et
GOSUB pickrnd
x1=x1+60
y1=y1+40
r=x1-60
IF r>160 THEN r=260-x1
IF y1-r<40 THEN r=260-y1
IF y1+r>140 THEN r=r=139-y1
CIRCLE (x1,y1),INT(RND*r)/2+1,INT(RND*32)
NEXT
END IF
IF c(1)=1 THEN
FOR i=1 TO et
GOSUB pickrnd
LINE (x1+60,y1+40)-(x2+60,y2+40),INT(RND*32)
NEXT i
END IF
IF c(2)=1 THEN
FOR i=1 TO et*10
GOSUB pickrnd
PSET(x1+60,y1+40),INT(RND*32)
NEXT
END IF
FOR c=0 TO 4
FOR r=0 TO 9
GET (r*20+60,c*20+40)-(r*20+79,c*20+59),a(0,c*10+r)
NEXT:NEXT
FOR i=0 TO 49
s$(i)=""
FOR j=3 TO 202
s$(i)=s$(i)+MKI$(a(j,i))
NEXT
NEXT
WINDOW CLOSE 3
CLS
LINE (57,38)-(263,142),3,b
LINE (56,37)-(264,143),3,b
FOR i=0 TO 31
PALETTE i,ocolor!(i,1),ocolor!(i,2),ocolor!(i,3)
NEXT
RETURN
pickrnd:
x1=INT(RND*200)
y1=INT(RND*100)
x2=INT(RND*200)
y2=INT(RND*100)
RETURN
quit:
LOCATE 1,1:PRINT STRING$(38,32)
LOCATE 1,9:COLOR 1:INPUT "Quit to system? (Y/N)";q$
q$=UCASE$(LEFT$(q$,1))
IF q$="Y" THEN SYSTEM
IF q$="N" THEN LOCATE 1,1:PRINT STRING$(38,32):RETURN
GOTO quit
CmdFile:
WINDOW 3,"Command File",(63,51)-(257,138),0,2
COLOR 1:PRINT:PRINT"Filename:"
LOCATE 9,4:PRINT"LOAD":LOCATE 9,16:PRINT"CANCEL"
LINE (22,62)-(56,72),2,b
LINE (118,62)-(168,72),2,b
cancel=0:GOSUB GetString
WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
IF cancel THEN RETURN
getpuz=1:puznum=0:d$=in$
GOTO Main
CmdGet:
ON ERROR GOTO DiskError
puznum=puznum+1
OPEN d$ FOR INPUT AS #1
FOR i=1 TO puznum
INPUT #1,f$,diff
NEXT
INPUT #1,a$:IF UCASE$(a$)="END" THEN lastpuz=1
CLOSE #1
f$=f$+".pzl"
GOSUB GetPuzzle
GOTO DiffLevel
About:
WINDOW 3,"<- Click here to resume",(63,51)-(257,138),8,2
COLOR 2
ON b GOTO Author,Game,Playing,Updates
Author:
PRINT:PRINT"This program written by":PRINT:PRINT"   Syd L. Bolton"
PRINT"   25 Frontenac Ave.":PRINT"   Brantford, Ontario"
PRINT"   Canada  N3R 3B7":PRINT
PRINT"I'm open to comments &":PRINT"suggestions!"
GOTO CloseWin
Game:
PRINT:PRINT"   Puzzle Pro v1.02":PRINT
PRINT"   Copyright ";CHR$(169);" 1987"
PRINT"    Oston Software"
PRINT:PRINT"This game is shareware,"
PRINT"and may be freely dis-"
PRINT"tributed. I do however"
PRINT"ask for a donation."
GOTO CloseWin
Playing:
PRINT:PRINT
PRINT"For some instruction,"
PRINT"& resident puzzles,"
PRINT"read PUZZLE.PRO.DOC',"
PRINT"located elsewhere on"
PRINT"this disk."
GOTO CloseWin
Updates:
PRINT"To receive a full"
PRINT"manual, game updates,"
PRINT"& puzzle data disks,"
PRINT"register by sending a"
PRINT"donation to me.  You"
PRINT"will be informed of"
PRINT"new releases, etc."
PRINT:PRINT"I really hope you like"
PRINT"this game!";
GOTO CloseWin
CloseWin:
WHILE (WINDOW(7)<>0 AND WINDOW(1)=3)
WEND
WINDOW CLOSE 3:WINDOW OUTPUT 2:WINDOW 2
RETURN